home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Snippets / baud / baud.p
Encoding:
Text File  |  1994-04-13  |  1.3 KB  |  52 lines  |  [TEXT/R*ch]
  1. program TestResetSer;
  2.  type
  3.   DataBitsT = (Five, Seven, Six, Eight); {sic}
  4.   ParityT = (OddParity, NoParity, EvenParity);
  5.   StopBitsT = (One, OnePointFive, Two);
  6. {}
  7.  var
  8.   f : text;
  9.  function ResetSer (Baud : longint;
  10.          DataBits : DataBitsT;
  11.          Parity : ParityT;
  12.          StopBits : StopBitsT) : boolean;
  13. { returns true if no error, false if modem port hasn't been opened yet }
  14.   const
  15.    PBControl = $A004;
  16.    noErr = 0;
  17.    ModemOutRefNum = -7;
  18.    SerReset = 8;
  19.   var
  20.    ParamBlockRec : record
  21.      Filler : array[0..11] of integer;
  22.      ioRefNum : integer;
  23.      csCode : integer;
  24.      csParam : integer
  25.     end;
  26.    RegRcd : record
  27.      A : array[0..4] of longint;
  28.      D : array[0..7] of longint
  29.     end;
  30.    serConfig : longint;
  31.  begin {ResetSer}
  32.   with ParamBlockRec do
  33.    begin
  34.     ioRefNum := ModemOutRefNum;
  35.     csCode := SerReset;
  36.     serConfig := trunc(114571.7 / baud - 1.338395)
  37.                  + 1024 * ord(DataBits)
  38.                  + 4096 * (ord(Parity) + 1)
  39.                  + 16384 * (ord(StopBits) + 1);
  40.     csParam := loword(serConfig);
  41.    end;
  42.   RegRcd.A[0] := ord(@ParamBlockRec);
  43.   generic(PBControl, RegRcd); {undocumented built-in procedure}
  44.   ResetSer := RegRcd.D[0] = noErr;
  45.  end; {ResetSer}
  46. {}
  47. begin {program}
  48.  open(f, 'modem:');
  49.  if not ResetSer(1200, Eight, NoParity, Two) then
  50.   writeln('ResetSer failed.');
  51. end.
  52.